{*******************************************************************************
 *                                                                             *
 *          Mathengine                                                         *
 *                                                                             *
 *          (C)Copyright Jimx 2011                                             *
 *                                                                             *
 *          http://math-engine.googlecode.com                                  *
 *                                                                             *
 *******************************************************************************
 *  This file is part of Mathengine.                                           *
 *                                                                             *
 *  Mathengine is free software:                                               *
 *  you can redistribute it and/or modify                                      *
 *  it under the terms of the GNU General Public License as published by       *
 *  the Free Software Foundation, either version 3 of the License, or          *
 *  (at your option) any later version.                                        *
 *                                                                             *
 *  Mathengine is distributed                                                  *
 *  in the hope that it will be useful,                                        *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of             *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *
 *  GNU General Public License for more details.                               *
 *                                                                             *
 *  You should have received a copy of the GNU General Public License          *
 *  along with Mathengine.                                                     *
 *  If not, see <http://www.gnu.org/licenses/>.                                *
 *******************************************************************************}
unit sci.expression;

interface
uses
  Winapi.Windows, Classes, SysUtils, Math, sci.types, sci.constants,
  sci.log, sci.functions;

type
  TExpressionType = (TYPE_EXPR, TYPE_BINARY, TYPE_UNARY, TYPE_FUNC, TYPE_CONST, TYPE_VAR);

{$REGION 'TSymbol'}
  TSymbol = (PLUS, MINUS, TIMES, DIVIDE, CARET, LPAREN, RPAREN, COMMA,
          //   +     -      *      /       ^      (         )      ,
              EQL, NEQ, LSS, GTR, LEQ, GEQ,
          //   =    <>   <    >    <=   >=
              NUMBER, IDENT, STR,
              ENDEXPR, ERROR);
{$ENDREGION}

{$REGION 'TExpression'}
// TExpression: An expression that can be evaluated.
  TExpression = class
    name: string;
    exprType: TExpressionType;
    constructor Create; overload;
    constructor Create(expr: string); overload;
    function getName: string; virtual;
    procedure setName(name: string); virtual;
    function getExprType: TExpressionType; virtual;
    function getRetType: TValueType; virtual;
    function getValueType: TValueType; virtual;
    procedure setValueType(valueType: TValueType); virtual;
    function getValue: TValue;  virtual;
    procedure setValue(value: TValue); virtual;
    function getSym: TSymbol; virtual;
    procedure setSym(sym: TSymbol); virtual;
    function getExpr1: TExpression; virtual;
    function getExpr2: TExpression; virtual;
    procedure setExpr1(expr: TExpression); virtual;
    procedure setExpr2(expr: TExpression); virtual;
    function getParams: TFuncParams; virtual;
    procedure setParams(params: TFuncParams); virtual;
    function eval: TValue; virtual;
    function evalAsInt: integer; virtual;
    function evalAsReal: real; virtual;
    function evalAsString: string; virtual;
  end;
{$ENDREGION}

{$REGION 'TConstantExpr'}
  TConstantExpr = class(TExpression)
    exprType: TExpressionType;
    valueType: TValueType;
    value: TValue;
    constructor Create; overload;
    constructor Create(value: TValue); overload;
    function getExprType: TExpressionType; override;
    function getValueType: TValueType; override;
    procedure setValueType(valueType: TValueType); override;
    function getValue: TValue; override;
    procedure setValue(value: TValue); override;
    function eval: TValue; override;
    function evalAsInt: integer; override;
    function evalAsReal: real; override;
  end;
{$ENDREGION}

{$REGION 'TVariableExpr'}
  TVariableExpr = class(TExpression)
    name: string;
    exprType: TExpressionType;
    valueType: TValueType;
    value: TValue;
    constructor Create; overload;
    constructor Create(name: string); overload;
    function getName: string; override;
    procedure setName(name: string); override;
    function getExprType: TExpressionType; override;
    function getValueType: TValueType; override;
    procedure setValueType(valueType: TValueType);  override;
    function getValue: TValue; override;
    procedure setValue(value: TValue); override;
  end;
{$ENDREGION}

{$REGION 'TUnaryExpression'}
  TUnaryExpression = class(TExpression)
    sym: TSymbol;
    exprType: TExpressionType;
    expr1: TExpression;
    constructor Create; overload;
    constructor Create(sym: TSymbol; expr1: TExpression);  overload;
    function getExpr1: TExpression; override;
    procedure setExpr1(expr: TExpression); override;
    function getExprType: TExpressionType;  override;
    function getSym: TSymbol; override;
    procedure setSym(sym: TSymbol); override;
    function eval: TValue; override;
    function evalAsInt: integer;  override;
    function evalAsReal: real;   override;
    function evalAsString: string; override;
  end;
{$ENDREGION}

{$REGION 'TBinaryExpression'}
  // A binary expression contains two operands separated by one operator.
  TBinaryExpression = class(TExpression)
    sym: TSymbol;
    exprType: TExpressionType;
    expr1, expr2: TExpression;
    constructor Create; overload;
    constructor Create(sym: TSymbol; expr1, expr2: TExpression);  overload;
    function getExpr1: TExpression; override;
    function getExpr2: TExpression; override;
    procedure setExpr1(expr: TExpression); override;
    procedure setExpr2(expr: TExpression); override;
    function getExprType: TExpressionType;  override;
    function getSym: TSymbol; override;
    procedure setSym(sym: TSymbol); override;
    function eval: TValue; override;
    function evalAsInt: integer;  override;
    function evalAsReal: real;   override;
    function evalAsString: string; override;
  end;
{$ENDREGION}

{$REGION 'TFunctionExpression'}
  TFunctionExpression = class(TExpression)
    name: string;
    exprType: TExpressionType;
    parameters: TFuncParams;
    constructor Create; overload;
    constructor Create(name: string; param: TFuncParams);  overload;
    function getParams: TFuncParams; override;
    procedure setParams(params: TFuncParams); override;
    function getExprType: TExpressionType;  override;
    function getName: string; override;
    procedure setName(name: string); override;
    function eval: TValue; override;
    function evalAsInt: integer;  override;
    function evalAsReal: real;   override;
    function evalAsString: string; override;
  end;
{$ENDREGION}

{$REGION 'TExpressionParser'}
  TExpressionParser = class
    expr: TStream;
  private
    lastWord: string;
    lastNumber: real;
    lastChar: char;
    sym: TSymbol;
    function getChar: char;
    procedure match(expected: TSymbol);
    function expression: TExpression;
    function simpleExpr: TExpression;
    function term: TExpression;
    function factor: TExpression;
  public
    procedure setStrExpression(expr: string);
    function getSymbol: TSymbol;
    function parse: TExpression;
    procedure printExpressionTree(e: TExpression; space: integer);
  end;
{$ENDREGION}

implementation

{$REGION 'TExpression'}
constructor TExpression.Create;
begin
  Self.name := 'EXPRESSION';
  Self.exprType := TYPE_EXPR;
end;

constructor TExpression.Create(expr: string);
var
  p: TExpressionParser;
begin
  p := TExpressionParser.Create;
  p.setStrExpression(expr);
  Self := p.parse;
  {$IFDEF DEBUG}
  p.printExpressionTree(Self, 0);
  {$ENDIF}
end;

function TExpression.getName: string;
begin
  Result := 'EXPRESSION';
end;

procedure TExpression.setName(name: string);
begin
  Self.name := name;
end;

function TExpression.getExprType: TExpressionType;
begin
  Result := TYPE_EXPR;
end;

function TExpression.getRetType: TValueType;
begin
  Result := TYPE_INT;
end;

function TExpression.getValueType: TValueType;
begin
  Result := TYPE_INT;
end;

procedure TExpression.setValueType(valueType: TValueType);
begin

end;

function TExpression.getValue: TValue;
begin
  Result := 0;
end;

procedure TExpression.setValue(value: TValue);
begin

end;

function TExpression.getSym: TSymbol;
begin
  Result := ENDEXPR;
end;

procedure TExpression.setSym(sym: TSymbol);
begin

end;

function TExpression.getExpr1: TExpression;
begin
  Result := nil;
end;

function TExpression.getExpr2: TExpression;
begin
  Result := nil;
end;

procedure TExpression.setExpr1(expr: TExpression);
begin

end;

procedure TExpression.setExpr2(expr: TExpression);
begin

end;

function TExpression.getParams: TFuncParams; 
begin

end;

procedure TExpression.setParams(params: TFuncParams);
begin

end;

function TExpression.eval: TValue;
begin
  Result := 0;
end;

function TExpression.evalAsInt: integer;
begin
  Result := 0;
end;

function TExpression.evalAsReal: real;
begin
  Result := 0;
end;

function TExpression.evalAsString: string;
begin
  Result := 'NULL';
end;

{$ENDREGION}

{$REGION 'TConstant'}

constructor TConstantExpr.Create;
begin
  Self.exprType := TYPE_CONST;
  Self.value := 0;
end;

constructor TConstantExpr.Create(value: TValue);
begin
  Self.exprType := TYPE_CONST;
  Self.value := value;
end;

function TConstantExpr.getExprType: TExpressionType;
begin
  Result := Self.exprType;
end;

function TConstantExpr.getValueType: TValueType;
begin
  Result := Self.valueType;
end;

procedure TConstantExpr.setValueType(valueType: TValueType);
begin
  Self.valueType := valueType;
end;

function TConstantExpr.getValue: TValue;
begin
  Result := Self.value;
end;

procedure TConstantExpr.setValue(value: TValue);
begin
  Self.value := value;
end;

function TConstantExpr.eval: TValue;
begin
  Result := Self.value;
end;

function TConstantExpr.evalAsInt: integer;
begin
  Result := Self.value;
end;

function TConstantExpr.evalAsReal: real;
begin
  Result := Self.value;
end;

{$ENDREGION}

{$REGION 'TVariable'}
constructor TVariableExpr.Create;
begin
  Self.name := 'VARIABLE';
  Self.exprType := TYPE_VAR;
  Self.valueType := TYPE_INT;
  Self.value := 0;
end;

constructor TVariableExpr.Create(name: string);
begin
  Self.name := name;
  Self.exprType := TYPE_VAR;
  Self.valueType := valueType;
  Self.value := value;
end;

function TVariableExpr.getName: string;
begin
  Result := Self.name;
end;

procedure TVariableExpr.setName(name: string);
begin
  Self.name := name;
end;

function TVariableExpr.getExprType: TExpressionType;
begin
  Result := Self.exprType;
end;

function TVariableExpr.getValueType: TValueType;
begin
  Result := Self.valueType;
end;

procedure TVariableExpr.setValueType(valueType: TValueType);
begin
  Self.valueType := valueType;
end;

function TVariableExpr.getValue: TValue;
begin
  Result := Self.value;
end;

procedure TVariableExpr.setValue(value: TValue);
begin
  Self.value := value;
end;

{$ENDREGION}

{$REGION 'TUnaryExpression'}

constructor TUnaryExpression.Create;
begin
  Self.sym := ENDEXPR;
  Self.exprType := TYPE_UNARY;
  Self.expr1 := nil;
end;

constructor TUnaryExpression.Create(sym: TSymbol; expr1: TExpression);
begin
  Self.sym := sym;
  Self.exprType := TYPE_UNARY;
  Self.expr1 := expr1;
end;

function TUnaryExpression.getExpr1: TExpression;
begin
  Result := Self.expr1;
end;

procedure TUnaryExpression.setExpr1(expr: TExpression);
begin
  Self.expr1 := expr;
end;

function TUnaryExpression.getExprType: TExpressionType;
begin
  Result := Self.exprType;
end;

function TUnaryExpression.getSym: TSymbol;
begin
  Result := Self.sym;
end;

procedure TUnaryExpression.setSym(sym: TSymbol);
begin
  Self.sym := sym;
end;

function TUnaryExpression.eval: TValue;
begin
  case Self.sym of
    MINUS: Result := -(Self.expr1.eval);
  end;
end;

function TUnaryExpression.evalAsInt: integer;
begin
  Result := 0;
  case Self.sym of
    MINUS: Result := -(Self.expr1.evalAsInt);
  end;
end;

function TUnaryExpression.evalAsReal: real;
begin
  Result := 0;
  case Self.sym of
    MINUS: Result := -(Self.expr1.evalAsReal);
  end;
end;

function TUnaryExpression.evalAsString: string;
begin
  Result := 'NULL';
end;
{$ENDREGION}

{$REGION 'TBinaryExpression'}
constructor TBinaryExpression.Create;
begin
  Self.sym := ENDEXPR;
  Self.exprType := TYPE_BINARY;
  Self.expr1 := nil;
  Self.expr2 := nil;
end;

constructor TBinaryExpression.Create(sym: TSymbol; expr1, expr2: TExpression);
begin
  Self.sym := sym;
  Self.exprType := TYPE_BINARY;
  Self.expr1 := expr1;
  Self.expr2 := expr2;
end;

function TBinaryExpression.getExpr1: TExpression;
begin
  Result := Self.expr1;
end;

function TBinaryExpression.getExpr2: TExpression;
begin
  Result := Self.expr2;
end;

procedure TBinaryExpression.setExpr1(expr: TExpression);
begin
  Self.expr1 := expr;
end;

procedure TBinaryExpression.setExpr2(expr: TExpression);
begin
  Self.expr2 := expr;
end;

function TBinaryExpression.getExprType: TExpressionType;
begin
  Result := Self.exprType;
end;

function TBinaryExpression.getSym: TSymbol;
begin
  Result := Self.sym;
end;

procedure TBinaryExpression.setSym(sym: TSymbol);
begin
  Self.sym := sym;
end;

function TBinaryExpression.eval: TValue;
begin

end;

function TBinaryExpression.evalAsInt: integer;
begin
  Result := 0;
  case Self.sym of
    PLUS:
    begin
      Result := Self.expr1.evalAsInt + Self.expr2.evalAsInt;
    end;
    MINUS:
    begin
      Result := Self.expr1.evalAsInt - Self.expr2.evalAsInt;
    end;
    TIMES:
    begin
      Result := Self.expr1.evalAsInt * Self.expr2.evalAsInt;
    end;
    DIVIDE:
    begin
      Result := Self.expr1.evalAsInt div Self.expr2.evalAsInt;
    end;
  end;
end;

function TBinaryExpression.evalAsReal: real;
begin
  Result := 0;
  case Self.sym of
    PLUS:
    begin
      Result := Self.expr1.evalAsReal + Self.expr2.evalAsReal;
    end;
    MINUS:
    begin
      Result := Self.expr1.evalAsReal - Self.expr2.evalAsReal;
    end;
    TIMES:
    begin
      Result := Self.expr1.evalAsReal * Self.expr2.evalAsReal;
    end;
    DIVIDE:
    begin
      Result := Self.expr1.evalAsReal / Self.expr2.evalAsReal;
    end;
  end;
end;

function TBinaryExpression.evalAsString: string;
begin
  Result := 'NULL';
end;

{$ENDREGION}

{$REGION 'TFunctionExpression'}

constructor TFunctionExpression.Create;
begin
  Self.name := 'FUNCTION';
  Self.exprType := TYPE_FUNC;
  fillchar(Self.parameters, sizeOf(Self.parameters), 0);
end;

constructor TFunctionExpression.Create(name: string; param: TFuncParams);
begin
  Self.name := name;
  Self.exprType := TYPE_FUNC;
  Self.parameters := param;
end;

function TFunctionExpression.getParams: TFuncParams;
begin
  Result := Self.parameters;
end;

procedure TFunctionExpression.setParams(params: TFuncParams);
begin
  Self.parameters := params;
end;

function TFunctionExpression.getExprType: TExpressionType;
begin
  Result := Self.exprType;
end;

function TFunctionExpression.getName: string;
begin
  Result := Self.name;
end;

procedure TFunctionExpression.setName(name: string);
begin
  Self.name := name;
end;

function TFunctionExpression.eval: TValue;
begin
  Result := 0;
end;

function TFunctionExpression.evalAsInt: integer;
begin
  Result := round(evalAsReal);
end;

function TFunctionExpression.evalAsReal: real;
var
  i: integer;
begin
  for i := 1 to funcsCount do
  begin
    if funcs[i].name = Self.name then
    begin
      Result := funcs[i].handler(Self.parameters);
      exit;
    end;
  end;
  raise Exception.Create('Unknown functions: ' + Self.name);
end;

function TFunctionExpression.evalAsString: string;
begin
  Result := 'NULL';
end;
{$ENDREGION}

{$REGION 'TExpressionParser'}

function isLetter(c: char): boolean;
begin
  Result := ((c >= 'A') and (c <= 'Z')) or ((c >= 'a') and (c <= 'z'));
end;

function isDigit(c: char): boolean;
begin
  Result := ((c >= '0') and (c <= '9')) or (c = '.');
end;

function isAlnum(c: char): boolean;
begin
  Result := isLetter(c) or isDigit(c);
end;

function symName(sym: TSymbol): string;
begin
  case sym of
    PLUS: Result := '+';
    MINUS: Result := '-';
    TIMES: Result := '*';
    DIVIDE: Result := '/';
    LPAREN: Result := '(';
    RPAREN: Result := ')';
    NUMBER: Result := 'NUMBER';
    IDENT: Result := 'IDENT';
    EQL: Result := '=';
    NEQ: Result := '<>';
    LSS: Result := '<';
    GTR: Result := '>';
    LEQ: Result := '<=';
    GEQ: Result := '>=';
    ENDEXPR: Result := 'END';
  end;
end;

function TExpressionParser.getChar;
var
  b: byte;
begin
  if expr.Position = expr.Size then
  begin
    result := char(-1);
    exit;
  end;
  expr.Read(b, 1);
  result := chr(b);
end;

procedure TExpressionParser.match(expected: TSymbol);
begin
  if Self.sym = expected then sym := getSymbol
  else raise Exception.Create('Unexpected symbol.');
end;

procedure TExpressionParser.setStrExpression(expr: string);
begin
  Self.expr := TStringStream.Create(expr);
  lastChar := getChar;
  sym := getSymbol;
end;

function TExpressionParser.getSymbol: TSymbol;
begin
  Result := ERROR;
  lastWord := '';
  if lastChar = char(-1) then exit(ENDEXPR);
  while ((lastChar = ' ')) do
    lastChar := getChar;                           // skip space and tab
  if isLetter(lastChar) then
  begin
    repeat
      lastWord := lastWord + lastChar;
      lastChar := getChar;
    until not isAlnum(lastChar);
    exit(IDENT);
  end
  else if isDigit(lastChar) then // number
  begin
    repeat
      lastWord := lastWord + lastChar;
      lastChar := getChar;
    until not isDigit(lastChar);
    lastNumber := strToFloat(lastWord);
    exit(NUMBER);
  end
  else if lastChar = '<' then
  begin
    lastChar := getChar;
    if lastChar = '=' then exit(LEQ)
    else if lastChar = '>' then exit(NEQ)
    else exit(LSS);
  end
  else if lastChar = '>' then
  begin
    lastChar := getChar;
    if lastChar = '=' then exit(GEQ)
    else exit(GTR);
  end
  else if lastChar = '+' then Result := PLUS
  else if lastChar = '-' then Result := MINUS
  else if lastChar = '*' then Result := TIMES
  else if lastChar = '/' then Result := DIVIDE
  else if lastChar = '^' then Result := CARET
  else if lastChar = '(' then Result := LPAREN
  else if lastChar = ')' then Result := RPAREN
  else if lastChar = '=' then Result := EQL
  else if lastChar = ',' then Result := COMMA;
  lastChar := getChar;
end;

function TExpressionParser.expression: TExpression;
var
  e, e1: TExpression;
begin
  e := simpleExpr();
  if ((sym = EQL) or (sym = NEQ) or (sym = GTR) or (sym = LSS) or
          (sym = LEQ) or (sym = GEQ)) then
  begin
    e1 := TBinaryExpression.Create;
    e1.setSym(sym);
    e1.setExpr1(e);
    match(sym);
    e1.setExpr2(simpleExpr);
    e := e1;
  end;
  Result := e;
end;

function TExpressionParser.simpleExpr: TExpression;
var
  e, e1: TExpression;
begin
  e := term();
  while ((sym = PLUS) or (sym = MINUS)) do
  begin
    e1 := TBinaryExpression.Create;
    e1.setSym(sym);
    e1.setExpr1(e);
    match(sym);
    e1.setExpr2(term());
    e := e1;
  end;
  Result := e;
end;

function TExpressionParser.term: TExpression;
var
  e, e1: TExpression;
begin
  e := factor();
  while ((sym = TIMES) or (sym = DIVIDE)) do
  begin
    e1 := TBinaryExpression.Create;
    e1.setSym(sym);
    e1.setExpr1(e);
    match(sym);
    e1.setExpr2(factor());
    e := e1;
  end;
  Result := e;
end;

function TExpressionParser.factor: TExpression;
var
  v: TValue;
  p: TFuncParams;
  cnt: integer;
  name: string;
  tmp: integer;
begin
  case sym of
    LPAREN:
    begin
      match(LPAREN);
      Result := expression;
      match(RPAREN);
    end;
    MINUS:  // Negative number
    begin
      match(MINUS);
      Result := TUnaryExpression.Create;
      Result.setSym(MINUS);
      Result.setExpr1(factor);
    end;
    NUMBER:
    begin
      Result := TConstantExpr.Create;
      if pos('.', floatToStr(lastNumber)) <> 0 then // float
      begin
        v := lastNumber;
        Result.setValue(v);
        Result.setValueType(TYPE_FLOAT);
      end
      else
      begin
        v := round(lastNumber);
        Result.setValue(v);
        Result.setValueType(TYPE_INT);
      end;
      match(NUMBER);
    end;
    IDENT:
    begin
      name := lastWord;
      Result := TVariableExpr.Create(name);
      match(IDENT);
      if sym = LPAREN then  // function
      begin
        Result := TFunctionExpression.Create;
        Result.setName(name);
        cnt := 0;
        match(sym);
        repeat
          if  sym <> RPAREN then
          begin
            inc(cnt);
            p[cnt] := expression.evalAsReal;
          end;
          if sym = COMMA then match(COMMA);
        until sym = RPAREN;
        match(RPAREN);
        Result.setParams(p);
      end
      else begin
        tmp := LookUpConst(name);
        if tmp <> -1 then
          Result := TConstantExpr.Create(GetConstAt(tmp));
      end;
    end;
    else
      raise Exception.Create('Unexcepted symbol.');
  end;
end;

function TExpressionParser.parse: TExpression;
begin
  Result := expression;
end;

procedure TExpressionParser.printExpressionTree(e: TExpression; space: integer);
  procedure printBlank(s: integer);
  var
    i: integer;
  begin
    for i := 1 to s do
      dbgprint(' ');
  end;
begin
  if e = nil then exit;
  case e.getExprType of
  TYPE_UNARY:
  begin
    printBlank(space);
    dbgprintln('Unary expression: ' + symName(e.getSym));
    printExpressionTree(e.getExpr1, space + 2);
  end;
  TYPE_BINARY:
  begin
    printBlank(space);
    dbgprintln('Binary expression: ' + symName(e.getSym));
    printBlank(space + 2);
    dbgprint('Left: ');
    printExpressionTree(e.getExpr1, space + 4);
    printBlank(space + 2);
    dbgprint('Right: ');
    printExpressionTree(e.getExpr2, space + 4);
  end;
  TYPE_CONST:
  begin
    printBlank(space);
    dbgprintln(format('Constant {i = %s, r = %s}', [IntToStr(e.getValue),
        FloatToStr(e.getValue)]));
  end;
  TYPE_VAR:
  begin
    printBlank(space);
    dbgprintln('Variable: ' + e.getName);
  end;
  end;
end;

{$ENDREGION}

end.
